home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / perl / usub / mus / arcfns next >
Encoding:
Text File  |  1990-11-25  |  4.2 KB  |  217 lines
  1. /* $Header: archimedes.mus,v 3.0.1.1 90/08/09 04:05:21 lwall Locked $
  2.  *
  3.  * $Log:    archimedes.mus,v $
  4.  * Revision 3.0.1.1  90/08/09  04:05:21  lwall
  5.  * patch19: Initial revision
  6.  * 
  7.  */
  8.  
  9. #include "EXTERN.h"
  10. #include "perl.h"
  11.  
  12. static enum uservars {
  13.     UV_Mode,
  14.     UV_Rows,
  15.     UV_Cols
  16. };
  17.  
  18. static enum usersubs {
  19.     US_osrdch,
  20.     US_oswrch,
  21.     US_osrdstr,
  22.     US_oswrstr,
  23.     US_fx
  24. };
  25.  
  26. static int usersub PROTO((int, int, int));
  27. static int userset PROTO((int, STR *));
  28. static int userval PROTO((int, STR *));
  29.  
  30. #define fx        _kernel_osbyte
  31.  
  32. void
  33. userinit()
  34. {
  35.     struct ufuncs uf;
  36.     char *filename = "C.Archimedes";
  37.  
  38.     uf.uf_set = userset;
  39.     uf.uf_val = userval;
  40.  
  41. #define MAGICVAR(name, ix) (uf.uf_index = ix, magicname(name, (char *)&uf, sizeof uf))
  42.  
  43.     MAGICVAR("Mode",    UV_Mode);
  44.     MAGICVAR("Rows",    UV_Rows);
  45.     MAGICVAR("Cols",    UV_Cols);
  46.  
  47.     make_usub("osrdch",        US_osrdch,    usersub, filename);
  48.     make_usub("oswrch",        US_oswrch,    usersub, filename);
  49.     make_usub("osrdstr",    US_osrdstr,    usersub, filename);
  50.     make_usub("oswrstr",    US_oswrstr,    usersub, filename);
  51.     make_usub("fx",        US_fx,        usersub, filename);
  52. }
  53.  
  54. static int
  55. usersub(ix, sp, items)
  56. int ix;
  57. register int sp;
  58. register int items;
  59. {
  60.     STR **st = stack->ary_array + sp;
  61.     register STR *Str;        /* used in str_get and str_gnum macros */
  62.  
  63.     switch (ix) {
  64.     case US_osrdch:
  65.         if (items != 0)
  66.             fatal("Usage: &osrdch()");
  67.         else {
  68.             int retval;
  69.         char retch;
  70.  
  71.             retval = _kernel_osrdch();
  72.         if (retval < 0)
  73.         st[0] = &str_undef;
  74.         else {
  75.         retch = retval;
  76.         str_nset(st[0], &retch, 1);
  77.         }
  78.         }
  79.         return sp;
  80.  
  81.     case US_oswrch:
  82.         if (items != 1)
  83.             fatal("Usage: &oswrch($char)");
  84.         else {
  85.         int ch = (int)str_gnum(st[1]);
  86.  
  87.         if (_kernel_oswrch(ch) < 0)
  88.         st[0] = &str_undef;
  89.         else
  90.         str_numset(st[0], 1.0);
  91.         }
  92.         return sp;
  93.  
  94.     case US_osrdstr:
  95.     if (items < 1 || items > 3)
  96.         fatal("Usage: &osrdstr($len,$lo_asc,$hi_asc)");
  97.     else {
  98.         STRLEN len = (int)str_gnum(st[1]);
  99.         int lo_asc = (items >= 2 ? (int)str_gnum(st[2]) : 32);
  100.         int hi_asc = (items >= 3 ? (int)str_gnum(st[3]) : 255);
  101.  
  102.         /* Register buffer for the OS call */
  103.         _kernel_swi_regs regs;
  104.  
  105.         /* Allocate the buffer, allowing 1 extra character for the CR */
  106.         STR_GROW(st[0], len+1);
  107.  
  108.         regs.r[0] = (int)st[0]->str_ptr;
  109.         regs.r[1] = (int)len;
  110.         regs.r[2] = lo_asc;
  111.         regs.r[3] = hi_asc;
  112.  
  113.         /* Clear escape flag */
  114.         _kernel_escape_seen();
  115.  
  116.         if (_kernel_swi(OS_ReadLine,®s,®s) || _kernel_escape_seen())
  117.         {
  118.         /* Return undef on an error or escape */
  119.         st[0] = &str_undef;
  120.         }
  121.         else
  122.         {
  123.         /* Set the result string to the correct length (the second
  124.          * parameter of 0 to str_nset() means leave the string's
  125.          * value unchanged)
  126.          */
  127.         str_nset(st[0], 0, regs.r[1]);
  128.         }
  129.     }
  130.     return sp;
  131.  
  132.     case US_oswrstr:
  133.     if (items != 1)
  134.         fatal("Usage: &oswrstr($str)");
  135.     else {
  136.         char *str = str_get(st[1]);
  137.         STRLEN len = st[1]->str_len;
  138.         _kernel_swi_regs regs;
  139.  
  140.         regs.r[0] = (int)str;
  141.         regs.r[1] = (int)len;
  142.         if (_kernel_swi(OS_WriteN,®s,®s))
  143.         st[0] = &str_undef;
  144.         else
  145.         str_numset(st[0], 1.0);
  146.     }
  147.     return sp;
  148.  
  149. CASE int fx
  150. I       int             op
  151. I       int             x
  152. I       int             y
  153. END
  154.  
  155.     default:
  156.     fatal("Unimplemented user-defined subroutine");
  157.     }
  158.     return sp;
  159. }
  160.  
  161. static int
  162. userval(ix, str)
  163. int ix;
  164. STR *str;
  165. {
  166.     int i;
  167.     int in[2];
  168.     int out[2];
  169.     _kernel_swi_regs regs;
  170.  
  171.     switch (ix) {
  172.     case UV_Mode:
  173.     i = fx(135,0,0);
  174.     i = (i >> 8) & 0xFF;
  175.     str_numset(str, (double)i);
  176.     break;
  177.     case UV_Rows:
  178.     in[0] = 257;
  179.     in[1] = -1;
  180.     regs.r[0] = (int)in;
  181.     regs.r[1] = (int)out;
  182.     if (_kernel_swi(OS_ReadVduVariables,®s,®s))
  183.         str_numset(str, -1.0);
  184.     else
  185.         str_numset(str, (double)(out[0]+1));
  186.     break;
  187.     case UV_Cols:
  188.     in[0] = 256;
  189.     in[1] = -1;
  190.     regs.r[0] = (int)in;
  191.     regs.r[1] = (int)out;
  192.     if (_kernel_swi(OS_ReadVduVariables,®s,®s))
  193.         str_numset(str, -1.0);
  194.     else
  195.         str_numset(str, (double)out[0]);
  196.     break;
  197.     }
  198.     return 0;
  199. }
  200.  
  201. static int
  202. userset(ix, str)
  203. int ix;
  204. STR *str;
  205. {
  206.     int i;
  207.  
  208.     switch (ix) {
  209.     case UV_Mode:
  210.     i = (int)str_gnum(str);
  211.     _kernel_oswrch(22);
  212.     _kernel_oswrch(i);
  213.     break;
  214.     }
  215.     return 0;
  216. }
  217.